#!/usr/bin/perl
use strict;

my $C = $0; $C =~ s{^.*/}{};

my $in = '@sysconfdir@/default/zipl2grub.conf.in';
my $default = '@sysconfdir@/default/grub';
my $fallback = '@sysconfdir@/zipl.conf';
my $sysconfbl = '@sysconfdir@/sysconfig/bootloader';
my $defimage = "/boot/image";
my $definitrd = "/boot/initrd";
my $Image = "$defimage";
my $previous = ".prev";
my $zipldir = "";
my $running = "";
my $refresh = 1; # needs to default to "on" until most bugs are shaken out!
my $force = 0;
my $verbose = 0;
my $debug = 0;
my $miss = 0;
my $cfg = "";
my %fsdev = ();
my %fstype = ();
my %SBL = (); # key/value of $sysconfbl

my %C = (
  GRUB_CMDLINE_LINUX_DEFAULT => "quiet splash=silent",
  GRUB_DISABLE_LINUX_UUID => "false",
);

my %Mandatory = (
  GRUB_CMDLINE_LINUX_DEFAULT => 1,
  GRUB_DEVICE => 1,
);

sub Panic($$) {
  printf( STDERR "%s", $_[1]);
  exit( $_[0]);
}
sub Info($$) {
  printf( STDERR "%s", $_[1]) if ($_[0] <= $verbose);
}
sub System(@) {
  my (@C) =@_;
  Info( 1, "+ " . join( " ", @C) . "\n");
  return 0 if ($debug);
  system( @C);
  if ($? == -1) {
    Panic( 1, "$C[0]: Failed to execute: $!\n");
  } elsif ($? & 127) {
    Panic( 1, sprintf( "$C[0]: Died with signal %d with%s coredump\n",
           ($? & 127),  ($? & 128) ? '' : 'out'));
  } elsif ( $? >> 8 != 0 ) {
    Panic( $? >> 8, "$C[0]: Failed\n");
  }
  return( 0);
}
sub cp($$) {
  my @C = ( "cp", "-p", $_[0], $_[1]);
  System( @C);
}
sub rm($) {
  return( 0) unless ( -l $_[0] || -e $_[0]);
  Info( 2, "+ rm $_[0]\n");
  return 0 if ($debug);
  unlink( $_[0]) || Panic( 1, "$C: unlink: $!.\n");
}
sub mv($$) {
  Info( 1, "+ mv $_[0] $_[1]\n");
  return 0 if ($debug);
  rename($_[0], $_[1]) || Panic( 1, "$C: rename: $!.\n");
}
sub ln($$) {
  Info( 1, "+ ln -sf $_[0] $_[1]\n");
  return 0 if ($debug);
  unlink( $_[1]) || Panic( 1, "$C: unlink: $!.\n") if ( -e $_[1]);
  symlink($_[0], $_[1]) || Panic( 1, "$C: symlink: $!.\n");
}

sub ManagePrev($$$){
  my( $file, $dir, $tgt) = @_;
  my $curr = "$dir/$tgt";
  my $prev = "$dir/$tgt$previous";
  my $ret = 0;
  Info(2, "Manage $prev\n");
  if ( -l $curr ) {
    my $curf = readlink( $curr);
    if ( $curf ne $file ) {
      if ( -l $prev ) {
	my $pref = readlink( $prev);
	$pref = "$dir/$pref" unless ($pref =~ m{^/});
	rm( $pref);
      }
      mv( $curr, $prev);
      $ret = 1;
    } else {
      Info(2, "  nothing to do ($curr -> $file).\n");
    }
  } else {
    Info(2, "  nothing to do ($curr no sym-link).\n");
  }
  return $ret;
}
sub BootCopy($$$$) {
  my( $src, $file, $dir, $tgt) = @_;
  my $curr = "$dir/$tgt";
  $src = "/boot/$src" unless ( -r $src );
  Info(4, "Copy $src $dir $tgt\n");
  if ( $tgt eq "image" && ManagePrev( $file, $dir, $tgt)) {
    ManagePrev( $file, $dir, "initrd")
  }
  cp( $src, "$dir/$file");
  ln( $file, $curr);
}
sub MkInitrd($$$) {
  my( $initrd, $dir, $version) = @_;
  my @C = ( "dracut", "--hostonly", "--force");
  my $uuid;
  push @C, "--quiet" unless ($verbose > 1);
  if ( exists( $fsdev{"/boot"}) ) {
  chomp( $uuid = qx{grub2-probe --target=fs_uuid /boot});
    my ($dev, $type) = ($fsdev{"/boot"},  $fstype{"/boot"});
    if ( $type eq "auto" ) {
      chomp( $type = qx{grub2-probe --target=fs /boot});
    }
    if ($C{GRUB_DISABLE_LINUX_UUID} eq "true" &&
	$dev =~ m{^(UUID=|/dev/disk/by-uuid/)}) {
      chomp( $dev = qx{grub2-probe --target=device /boot});
    }
    push @C, "--mount", "$dev /boot $type ro";
  }
  push @C, "$dir/$initrd", $version;
  System( @C);
  ln( $initrd, "$dir/initrd");
}
sub ChkInitrd($$) {
  my( $dir, $initrd) = @_;
  my $found = -1;
  my $d = $dir;
  my $pattern = qr{lib/dracut/hooks/cleanup/99-grub2.sh};
  my $show = "cleanup/99-grub2.sh";
  my $cat = undef;
  my $magic;

  return $found unless (-r "$dir/$initrd");
  open( IN, "< $dir/$initrd") || return $found;
  my $rd = sysread( IN, $magic, 6);
  close( IN);
  return $found unless (defined( $rd) && $rd == 6);
  $cat = "xzcat" if ($magic eq "\xFD7zXZ\x00");
  $cat = "zcat"  if (substr($magic, 0, 2) eq "\037\213");
  $cat = "cat"   if (substr($magic, 0, 5) eq "07070");
  return $found unless (defined($cat));

  my $modinst = "/usr/lib/dracut/modules.d/99grub2/module-setup.sh";
  if ( -r $modinst ) {
    my( $hook, $ord, $script);
    my $pat = qr{^\s*inst_hook\s+(\S+)\s+([0-9]+)\s+\"\$moddir/(grub2\.sh)\"};
    open( IN, "< $modinst") || die;
    while ( <IN> ) {
      next unless ($_ =~ $pat);
      $show = "$1/$2-$3";
      $pattern = qr{lib/dracut/hooks/$show}o;
      last;
    }
    close( IN);
  }

  $found = 0;
  Info( 3, "+ $cat $d/$initrd | cpio -it | grep '$show'\n");
  open( IN, "$cat $d/$initrd | cpio -it 2>/dev/null |") ||
     Panic( 1, "$C: cpio: $!.\n");
  while ( <IN> ) {
    $found = 1 if ($_ =~ $pattern);
  }
  close( IN);
  return $found;
}

sub Usage($) {
  my @cat = ("",
	"Parameter error.",
	"zIPL directory missing.",
	"Configuration template missing.",
	"Configuration template unreadable.",
	"zIPL directory not accessible.",
	"kernel image parameter missing.",
	"kernel image unreadable.",
	""
  );
  my $msg = "";

  $msg .= sprintf( "%s: %s\n", $C, $cat[$_[0]]) if ($_[0] > 0);
  $msg .= "Usage: $C [-v] [-d] [-f] [-T template] [-z ZIPLDIR] [-i imagepath]\n";
  Panic( $_[0], $msg . "\n");
}

while ( $#ARGV >= 0 ) {
  $_ = shift;
  next if /^$/;
  last if /^--$/;
  (/^--verbose$/ || /^-v$/)   && ($verbose++, next);
  (/^--quiet$/ || /^-q$/)     && ($verbose = 0, next);
  (/^--debug$/ || /^-d$/)     && ($debug = 1, $verbose++, next);
  (/^--force$/ || /^-f$/)     && ($force = $refresh = 1, next);
  (/^--refresh$/ || /^-r$/)   && ($refresh = 1, next);
  (/^--keep$/ || /^-k$/)      && ($refresh = 0, next);
  (/^--?help/ || /^-h/)       && (Usage(0));
  (/^--zipldir$/ || /^-z$/)   && ($zipldir = shift || Usage(2), next);
  (/^--template$/ || /^-T$/)  && ($in = shift || Usage(3), next);
  (/^--image$/ || /^-i$/)     && ($Image = shift || Usage(6),
				  -r "$Image" || Usage(7), $force = 1, next);
  (/^-/)                      && (Usage(1));
  Usage(1);
}
Usage(4) if (! -r $in);

if ($zipldir) {
  $C{zipldir} = $zipldir;  # command-line wins
} elsif ( exists( $C{zipldir}) ) {
  $zipldir = $C{zipldir};  # otherwise fall back to config
} else {
  $zipldir = $C{zipldir} = "/boot/zipl"; # but don't proceed without...
}
Usage(5) if (! -d $zipldir);
if ( $zipldir eq "/boot" ) {
  Panic( 5, "$C: zIPL directory '/boot' not supported!\n");
}

if ( ! -r $default && ! -r $fallback && ! -r $sysconfbl ) {
  Panic( 0, "$C: No configuration files found. Retry later!\n");
}
if ( -r $default ) {
  open( IN, "< $default") || die;
  while ( <IN> ) {
    chomp;
    s{^\s*#.*$}{};
    next if m{^\s*$};
    s{x}{\x01xx\x01}g;
    s{\\\"}{\x01x1\x01}g;
    s{\\\'}{\x01x2\x01}g;
    Info( 5, "<$_>\n");
    if ( m{^([^\s=]+)='([^']*)'\s*(?:#.*)?$} ||
         m{^([^\s=]+)="([^"]*)"\s*(?:#.*)?$} ||
         m{^([^\s=]+)=(\S*)\s*(?:#.*)?$} ) {
      my ( $k, $v) = ($1, $2);
      $v =~ s{\x01x2\x01}{\\'}g;
      $v =~ s{\x01x1\x01}{\\"}g;
      $v =~ s{\x01xx\x01}{x}g;
      $C{$k} = $v;
      next;
    }
    print( STDERR "$default:$.: parse error ignored.\n");
  }
  close( IN);
}
if ( -r $sysconfbl ) {
  open( IN, "< $sysconfbl") ||  die;
  while ( <IN> ) {
    next if ( m{^\s*#} );
    next unless ( m{^\s*([^=#\s]+)="(.*)"(?:\s*|\s+#.*)$} );
    $SBL{$1} = $2;
  }
  close( IN);
}
if ( -r "/etc/fstab" ) {
  my $regex = qr{^(\S+)\s+(\S+)\s+(\S+)\s+\S+\s+\S+\s+\S+\s*(?:#.*)?$};
  open( IN, "< /etc/fstab") || die;
  while ( <IN> ) {
    next if ( m{^\s*#} );
    my ($dev, $mp, $type) = (m{$regex}o);
    $fsdev{$mp} = $dev;
    $fstype{$mp} = $type;
  }
  close( IN);
}

if ( ! exists( $C{GRUB_DEVICE}) &&
     $C{GRUB_CMDLINE_LINUX_DEFAULT} eq "quiet splash=silent" &&
     -r $fallback ) {
  # configuration incomplete, let's try fallback
    open( IN, "< $fallback") || die;
    my $section = "";
    while( <IN> ){
      if ( m{^\[([^\]]+)\]\s*$} ) {
        $section = $1;
      }
      if ( $section eq "ipl" &&
	   m{^\s*parameters\s*=\s*\"root=(\S+)(?:\s*|\s+([^\"]+))\"} ) {
        $C{GRUB_DEVICE} = $1;
        $C{GRUB_CMDLINE_LINUX_DEFAULT} = $2 if (defined($2) && $2 !~ m{^\s*$});
        last;
      }
    }
    close( IN);
    $default = $fallback;
}

if ( ! exists( $C{GRUB_DEVICE}) && exists( $fsdev{"/"}) ) {
  my( $dev, $type, $subvol) = ( $fsdev{"/"}, $fstype{"/"}, "");
  if ( $dev !~ m{^(UUID=|/dev/disk/by-uuid/)} ||
       $C{GRUB_DISABLE_LINUX_UUID} ne "true" ) {
    $C{GRUB_DEVICE} = $dev;
    # grub2-mkrelpath fails on rollback -- and provides no known merit...
    #chomp( $subvol = qx{grub2-mkrelpath /}) if ( $type eq "btrfs" );
    #$subvol =~ s{^/}{};
    #$C{GRUB_DEVICE} .= " rootflags=subvol=$subvol" if ($subvol);
  }
}
if ( ! exists( $C{GRUB_DEVICE}) ) {
  my( $dev, $uuid, $type, $subvol) = ("", "", "", "");
  chomp( $dev  = qx{grub2-probe --target=device /});
  chomp( $uuid = qx{grub2-probe --device $dev --target=fs_uuid});
  if ( $dev ) {
    if ( $uuid && $C{GRUB_DISABLE_LINUX_UUID} ne "true" ) {
      $C{GRUB_DEVICE} = "UUID=$uuid";
    } else {
      $C{GRUB_DEVICE} = "$dev";
    }
    chomp( $type = qx{stat -f --printf='%T' /});
    # grub2-mkrelpath fails on rollback -- and provides no known merit...
    #chomp( $subvol = qx{grub2-mkrelpath /}) if ( $type eq "btrfs" );
    #$subvol =~ s{^/}{};
    #$C{GRUB_DEVICE} .= " rootflags=subvol=$subvol" if ($subvol);
  }
}
if ( $C{GRUB_CMDLINE_LINUX_DEFAULT} eq "quiet splash=silent" &&
     exists( $SBL{DEFAULT_APPEND}) ) {
  $C{GRUB_CMDLINE_LINUX_DEFAULT} = $SBL{DEFAULT_APPEND};
}

if ( ! exists( $C{GRUB_DEVICE})) {
  Panic( 0, "$C: Default not ready and no fallback.  Please retry later!\n");
}

if ( !exists( $C{SUSE_SECURE_BOOT}) ) {
  $C{SUSE_SECURE_BOOT} = "0";
  if ( exists( $SBL{SECURE_BOOT}) && $SBL{SECURE_BOOT} =~ m{^(yes|true|1)$} ) {
    $C{SUSE_SECURE_BOOT} = "1";
  }
}

if ( ! exists( $C{GRUB_EMU_CONMODE}) && exists( $C{GRUB_CONMODE}) ) {
  # GRUB_CONMODE is used for 'grub2-emu' as well
  $C{GRUB_EMU_CONMODE} = $C{GRUB_CONMODE};
}
if ( exists( $C{GRUB_EMU_CONMODE}) && !exists( $C{GRUB_CONMODE}) ) {
  # pick up 'conmode=' from CMDLINE
  my $found = "";
  foreach ( "GRUB_CMDLINE_LINUX", "GRUB_CMDLINE_LINUX_DEFAULT" ) {
    next unless ($C{$_} =~ m{ ?conmode=(\S+) ?});
    $C{GRUB_CONMODE} = $1;
    last;
  }
  if ( !exists( $C{GRUB_CONMODE}) && $C{GRUB_EMU_CONMODE} eq "3270" ) {
    # force GRUB_CONMODE to 3215 for least surprise
    $C{GRUB_CONMODE}="3215";
  }
}
if ( exists( $C{GRUB_EMU_CONMODE}) && exists( $C{GRUB_CONMODE})) {
  # strip "conmode=" from GRUB_CMDLINE{,_LINUX}_DEFAULT
  foreach ( "GRUB_CMDLINE_LINUX", "GRUB_CMDLINE_LINUX_DEFAULT" ) {
    $C{$_} =~ s{( ?)conmode=\S+ ?}{$1}g;
  }
}
foreach ("GRUB_EMU_CONMODE", "GRUB_CONMODE") {
  next unless( exists( $C{$_}) );
  $C{$_} = "conmode=" . $C{$_};
}

if ( $debug && $verbose > 2 ) {
  foreach ( sort( keys( %C)) ) {
    printf( "%s=\"%s\"\n", $_, $C{$_});
  }
  foreach ( sort( keys( %SBL)) ) {
    printf( "SBL: %s=\"%s\"\n", $_, $SBL{$_});
  }
}

open( IN, "< $in") ||
   Panic( 1, "$C: Failed to open 'zipl.conf' template: $!.\n");
while ( <IN> ) {
  Info( 4, "$.. <$_$.. >");
  if ( $. == 1 && m{^## This} ) {
    $_ = "## This file was written by 'grub2-install/$C'\n" .
	 "## filling '$in' as template\n";
  } elsif ( $. == 2 && m{^## rpm's} ) {
    $_ = "## with values from '$default'.\n" .
	 "## In-place modifications will eventually go missing!\n";
  }
  while ( m{\@([^\@\s]+)\@} ) {
    my $k = $1;
    my $v;
    if ( exists( $C{$k}) ) {
      $v = $C{$k};
    } elsif ( exists( $Mandatory{$k}) ) {
      $v =  "$k";
      $miss++;
    } else {
      $v = "";
    }
    if ($k eq "GRUB_DEVICE") {
      if (($v !~ /^UUID/ && ! -e $v) ||
          (exists( $C{SUSE_REMOVE_LINUX_ROOT_PARAM}) &&
          $C{SUSE_REMOVE_LINUX_ROOT_PARAM} eq "true")) {
        s{root=\@$k\@}{}g;
        next;
      }
    }
    s{\@$k\@}{$v}g;
  }
  Info( 3, $_);
  $cfg .= $_;
}
if ( $miss ) {
  Info( 1, "Partially filled config:\n===\n$cfg===\n");
  Panic( 1, "$C: 'zipl.conf' template could not be filled. \n");
}

# copy out kernel and initrd
my $ziplimage = "$zipldir/image";
my $ziplinitrd = "$zipldir/initrd";

if ( ! $running && ! $force ) {
  chomp( $running = qx{uname -r});
  Info( 1, "preferred kernel: '$running'\n");
  $Image .= "-$running";
}
if ( ! -r $Image ) {
  $Image = $defimage;
}
Panic( 1, "$C: kernel '$Image' not readable!?\n") unless (-r $Image);

my ($image, $version) = ($Image, undef);
while ( !defined( $version) ) {
  my ($i, $vr, $f) = ($image =~ m{^(?:/boot/)?([^-/]+)-([^/]+)-([^-/]+)$});
  Info( 4, "image='$image': ");
  if ( defined($i) && defined($vr) && defined( $f) && -r "/boot/$i-$vr-$f" ) {
    Info( 4, "matches pattern ('$vr'-'$f')\n");
    $version = "$vr-$f";
    last;
  }
  if ( -l $image ) {
    Info( 4, "readlink...\n");
    $image = readlink( $image);
    next;
  }
  Info( 4, "last resort: get_kernel_version from original '$Image'...\n");
  chomp( $version = qx{get_kernel_version $Image});
  Panic( 1, "$C: failed to get kernel version for '$Image'!\n")
    unless ( defined( $version) && $version );
}
my $initrd = "initrd-$version";
$image = "image-$version";

if ( ! -r $ziplimage || ! -r $ziplinitrd || $refresh ) {
  BootCopy( $Image, $image, $zipldir, "image");
  BootCopy( $initrd, $initrd, $zipldir, "initrd")
    if (-r "/boot/$initrd" && ! exists( $fsdev{"/boot"}));
}
if ( $refresh || ChkInitrd( $zipldir, "initrd") <= 0 ) {
  MkInitrd( $initrd, $zipldir, $version);
}
if ( ChkInitrd( $zipldir, "initrd") == 0 ) {
  Info( 0, "$C: dracut does not work as expected! Help needed!\n");
  $miss++;
}

# write zipl config file
my $ziplconf = "$zipldir/config";
$cfg =~ s{#@}{}g if ( -r "$ziplimage$previous"  && -r "$ziplinitrd$previous" );
if ( ! $debug ) {
  open( OUT, "> $ziplconf") || die;
  print( OUT $cfg) || die;
  close( OUT);
} else {
  print( STDERR $cfg);
}

# now: go for it!
my @C = ( "/sbin/zipl", (($verbose > 1) ? "-Vnc" : "-nc"), "$ziplconf" );
System( @C);
exit( $miss);

